home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Baxterdatt2110784252008.psc / Baxterdattleweezle Virus / clsConsole.cls < prev    next >
Text File  |  2000-05-30  |  6KB  |  197 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsConsole"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. Option Explicit
  17.  
  18. 'based upon the DOS Console posted on http://www.planet-source-code.com/  by Loreno Heer
  19.  
  20. Private Declare Function AllocConsole Lib "kernel32" () As Long
  21. Private Declare Function FreeConsole Lib "kernel32" () As Long
  22. Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
  23. Private Declare Function ReadConsole Lib "kernel32" Alias "ReadConsoleA" (ByVal hConsoleInput As Long, ByVal lpBuffer As String, ByVal nNumberOfCharsToRead As Long, lpNumberOfCharsRead As Long, lpReserved As Any) As Long
  24. Private Declare Function SetConsoleMode Lib "kernel32" (ByVal hConsoleOutput As Long, dwMode As Long) As Long
  25. Private Declare Function SetConsoleTextAttribute Lib "kernel32" (ByVal hConsoleOutput As Long, ByVal wAttributes As Long) As Long
  26. Private Declare Function SetConsoleTitle Lib "kernel32" Alias "SetConsoleTitleA" (ByVal lpConsoleTitle As String) As Long
  27. Private Declare Function WriteConsole Lib "kernel32" Alias "WriteConsoleA" (ByVal hConsoleOutput As Long, ByVal lpBuffer As Any, ByVal nNumberOfCharsToWrite As Long, lpNumberOfCharsWritten As Long, lpReserved As Any) As Long
  28. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  29. Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
  30. Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  31.  
  32. Private Const STD_INPUT_HANDLE = -10&
  33. Private Const STD_OUTPUT_HANDLE = -11&
  34. Private Const STD_ERROR_HANDLE = -12&
  35. Private Const FOREGROUND_RED = &H4
  36. Private Const FOREGROUND_GREEN = &H2
  37. Private Const FOREGROUND_BLUE = &H1
  38. Private Const FOREGROUND_INTENSITY = &H8
  39. Private Const BACKGROUND_RED = &H40
  40. Private Const BACKGROUND_GREEN = &H20
  41. Private Const BACKGROUND_BLUE = &H10
  42. Private Const BACKGROUND_INTENSITY = &H80
  43. Private Const ENABLE_LINE_INPUT = &H2
  44. Private Const ENABLE_ECHO_INPUT = &H4
  45. Private Const ENABLE_MOUSE_INPUT = &H10
  46. Private Const ENABLE_PROCESSED_INPUT = &H1
  47. Private Const ENABLE_WINDOW_INPUT = &H8
  48. Private Const ENABLE_PROCESSED_OUTPUT = &H1
  49. Private Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2
  50.  
  51. Private hConsoleIn As Long
  52. Private hConsoleOut As Long
  53. Private hConsoleErr As Long
  54.  
  55. Private Const SWP_NOMOVE = 2
  56. Private Const SWP_NOSIZE = 1
  57. Private Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
  58. Private Const HWND_TOPMOST = -1
  59. Private Const HWND_NOTOPMOST = -2
  60. Private Const SWP_SHOWWINDOW = &H40
  61.  
  62. Private Const WM_CLOSE = &H10
  63. Private Const SW_HIDE = 0
  64. Private Const SW_SHOWNORMAL = 1
  65. Private Const SW_MAXIMIZE = 3
  66. Private Const SW_SHOW = 5
  67. Private Const SW_MINIMIZE = 6
  68. Private Const SW_RESTORE = 9
  69.  
  70. 'local variable(s) to hold property value(s)
  71. Private mvarLogFilePathName As String 'local copy
  72. Private mvarConsoleWindowTitle As String 'local copy
  73.  
  74. Public Property Let ConsoleWindowTitle(ByVal vData As String)
  75.  
  76.     mvarConsoleWindowTitle = vData
  77.  
  78. End Property
  79.  
  80.  
  81. Public Property Get ConsoleWindowTitle() As String
  82.  
  83.     ConsoleWindowTitle = mvarConsoleWindowTitle
  84.  
  85. End Property
  86.  
  87.  
  88. Public Sub WriteOut(ByVal Msg As String, Optional ByVal LogIt As Boolean = False)
  89.  
  90.   Msg = Format(Now, "hh:nn:ss") & " " & Msg
  91.   
  92.   Msg = Msg & vbCrLf
  93.   
  94.   WriteConsole hConsoleOut, Msg, Len(Msg), vbNull, vbNull
  95.   
  96.   If LogIt Then WriteLog Msg
  97.     
  98. End Sub
  99.  
  100.  
  101. Public Sub Important(ByVal Msg As String, Optional ByVal LogIt As Boolean = False)
  102.   
  103.   SetConsoleTextAttribute hConsoleOut, FOREGROUND_RED Or FOREGROUND_INTENSITY
  104.   
  105.   WriteOut "---------------------------------------------------------------------", LogIt
  106.   WriteOut Msg, LogIt
  107.   WriteOut "---------------------------------------------------------------------", LogIt
  108.   
  109.   SetConsoleTextAttribute hConsoleOut, FOREGROUND_RED Or FOREGROUND_GREEN Or FOREGROUND_BLUE
  110.   
  111. End Sub
  112.  
  113.  
  114. Public Property Let LogFilePathName(ByVal vData As String)
  115.     
  116.   mvarLogFilePathName = vData
  117.  
  118. End Property
  119.  
  120.  
  121. Public Property Get LogFilePathName() As String
  122.     
  123.   LogFilePathName = mvarLogFilePathName
  124.  
  125. End Property
  126.  
  127.  
  128. Private Function CGet() As String
  129.    
  130.   Dim sUserInput As String * 256
  131.   Call ReadConsole(hConsoleIn, sUserInput, Len(sUserInput), vbNull, vbNull)
  132.   CGet = Left$(sUserInput, InStr(sUserInput, Chr$(0)) - 3)
  133.  
  134. End Function
  135.  
  136.  
  137. Public Sub CloseConsole()
  138.    
  139.   FreeConsole
  140.    
  141. End Sub
  142.  
  143.  
  144. Public Sub LoadConsole()
  145.    
  146.   Dim lHwnd As Long
  147.   Dim ConsoleTitle As String
  148.   
  149.   ConsoleTitle = ConsoleWindowTitle()
  150.   
  151.   AllocConsole
  152.   SetConsoleTitle ConsoleTitle
  153.   hConsoleIn = GetStdHandle(STD_INPUT_HANDLE)
  154.   hConsoleOut = GetStdHandle(STD_OUTPUT_HANDLE)
  155.   hConsoleErr = GetStdHandle(STD_ERROR_HANDLE)
  156.  
  157.   lHwnd = FindWindow("ConsoleWindowClass", ConsoleTitle)
  158.   
  159.   ShowWindow lHwnd, SW_SHOWNORMAL
  160.   Call SetWindowPos(lHwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  161.   Call SetWindowPos(lHwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
  162.     
  163. End Sub
  164.  
  165.  
  166. Private Sub WriteLog(sMsg As String)
  167.  
  168.   If LogFilePathName = "" Then Exit Sub
  169.   
  170.   Dim intFile As Integer   ' FreeFile variable
  171.   
  172.   intFile = FreeFile()
  173.   
  174.   Open LogFilePathName For Append As #intFile
  175.   Print #intFile, sMsg
  176.   Close #intFile
  177.   
  178. End Sub
  179.  
  180.  
  181. Private Function FileExists(FullPathandFile As String) As Boolean
  182.  
  183.   On Error Resume Next
  184.   
  185.   If FileLen(FullPathandFile) > 0& Then
  186.     If Err = 0 Then FileExists = True
  187.   End If
  188.  
  189. End Function
  190.  
  191.  
  192. Private Sub Class_Terminate()
  193.  
  194.   CloseConsole
  195.   
  196. End Sub
  197.